perm filename NEW.OLD[XX,LCS]2 blob
sn#208672 filedate 1976-06-15 generic text, type T, neo UTF8
00100 TITLE BMSTF ;0300 SUBROUTINE BMSTF
00110 ENTRY BMSTF
00120 EXTERNAL STAFF,RHORZ,AMOD,NOZERO,IFIX,LINES,BMS,MAKNUM
00130 EXTERNAL .COMM.,ALF,POSI,STF,MIN,BM,PLTR
00200 BMSTF: 0 ;00400 IMPLICIT INTEGER(A-Q,S-Z)
00300 ;00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
00400 ;00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
00500 ;00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
00600 ;00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
00700 ;00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
00800 ;01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
00900 ;01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
01000 ;01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
01100 ;01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1
01200 ;01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,R
01300 ;01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
01400 ;01600 C RDBR IS SPACER FOR DBL BAR.
01600 ; 01710 IF(JA.NE.8)GO TO 100
01700 MOVEI 02,10
01800 CAME 02,.COMM.+1
01900 JRST BS100
02000 ; 01720 CALL STAFF
02100 JSA 16,STAFF
02200 JRA 16,(16) ;1730 RETURN
02400 ; 02000 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
02500 ; 02200 R3Q=R3
02600 BS100: MOVE 13,.COMM.+4
02700 MOVE 10,.COMM.+=31 ; 10 IS J10, 13 IS R3Q
02800 ; 02400 C NEXT IS FOR BEAMS
02900 ; 02500 RMINI=RSTJ2
03000 MOVE 12,STF+=8
03100 MOVEM 12,MIN+1
03200 ; 02600 RX=2.7*RSTJ2*5.96
03300 FMPR 12,[16.092] ; 12 IS RX
03410 MOVE 5,.COMM.+=10 ; SAVE R9 IN 5
03420 MOVE 6,.COMM.+=28 ; 6 IS J7
03440 MOVE 14,.COMM.+=29 ; J8
03500 ;; 02800 R6=RHORZ(R6)
03600 JSA 16,RHORZ
03700 JUMP .COMM.+7
03800 MOVEM 00,.COMM.+7
04000 MOVSI 2,204500 ; (10.0) IF(R8.NE.0)GO TO 204
04100 SKIPN .COMM.+=9
04200 CAMG 2,.COMM.+=11
04210 JRST BS204 ; IF(R10.GE.10)GO TO 204
04900 ; 03100 IF(J7)GO TO 204
05100 JUMPL 6,BS204
05300 ; 03200 IF(R9.NE.0)GO TO 1
05500 JUMPN 5,BS1
05700 ; R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
05900 ; 03400 204 IF(R9.NE.0)R9=RHORZ(R9)
06400 BS204: JUMPE 5,.+4
06500 JSA 16,RHORZ
06600 JUMP .COMM.+=10
06700 MOVEM 5 ; 5 IS R9
06900 JUMPL 6,BS201 ; IF(J7)GO TO 201
07500 BS200: CAIGE 10,=10 ; 200 IF(J10.LT.10)GO TO 91
07700 JRST BS91
07900 ; 03700 C NEXT FOR INNER, PARTIAL BEAMS
08100 ; 03800 R8=RHORZ(R8)
08200 JSA 16,RHORZ
08300 JUMP .COMM.+=9
08400 MOVEM 00,.COMM.+=9
08600 ; 03900 R10=AMOD(R10,10.)
08700 JSA 16,AMOD
08800 JUMP .COMM.+=11
08900 JUMP [10.0]
09000 MOVEM 00,.COMM.+=11
09200 ; 04000 GO TO(2,3,4),.COMM.+=31/10
09300 MOVE 02,10
09400 IDIVI 02,12
09500 CAIN 2,3
09550 JRST BS4
09600 CAIN 2,2
10300 JRST BS3 ;4100 2 RH=R9+RX
10400 BS2: MOVE 02,12
10500 FADR 02,5
10600 MOVEM 02,RH#
10800 ; 04200 GO TO 1
10900 JRST BS1
11100 ; 04300 3 R8=R9-RX
11200 BS3: MOVN 02,12
11600 FADR 02,5
11700 MOVEM 02,.COMM.+=9;10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8
12100 ; 04500 4 RH=R8
12200 BS4: MOVE 02,.COMM.+=9
12300 MOVEM 02,RH
12500 ; 04600 C LEFT INNER POS.
12700 ; 04700 GO TO 1
12800 JRST BS1
13000 ; 04800 201 J7=-J7
13100 BS201: MOVNS 6
13300 ;4900 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
13500 ; 05000 CALL NOZERO(R10)
13600 JSA 16,NOZERO
13700 JUMP .COMM.+=11
13900 ; ALWAYS AT LEAST 1 IN DISPLACEMENT
14100 ; 05200 J10=30
14200 MOVEI 10,36
14300 ; TO ACTIVATE PARTIAL BEAM SECTION
14700 ; 05400 IF(J9.NE.0)GO TO 202
14800 MOVE 02,.COMM.+=30
14900 JUMPN 02,BS202
15100 ; 05500 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
15300 ; 05600 RH=-1
15400 MOVSI 02,576400
15700 CAIL 6,24 ;5700 IF(J7.GE.20)RH=-RH
16100 MOVNS 2
16110 MOVEM 02,RH
17100 ; 06000 R5=R4+RH
17300 FADR 02,.COMM.+5
17400 MOVEM 02,.COMM.+6
17600 ; 06100 R9=R3
17700 MOVE 05,.COMM.+4
18000 ; 06200 R6=R3+22.*RMINI
18100 MOVSI 02,205540
18200 FMPR 02,MIN+1
18300 FADR 02,.COMM.+4
18400 MOVEM 02,.COMM.+7
18600 ; 06300 202 IF(R8.EQ.0)R8=4.
18700 BS202: MOVE 12,.COMM.+=9
18800 JUMPN 12,.+3
18900 MOVSI 12,203400
19000 MOVEM 12,.COMM.+=9
19300 ; 06400 RX=R8*RMINI*2.98
19400 FMPR 12,MIN+1
19600 FMPR 12,[2.98]
19900 ; 06500 RH=R9+RX
20000 MOVE 02,12
20100 FADR 02,5
20200 MOVEM 02,RH
20400 ; 06600 R9=R9-RX
20500 MOVN 02,12
20600 FADRM 02,5
20800 ; 06700 GO TO 1
20900 JRST BS1
21400 BS91: JUMPE 14,BS1 ; 91 IF(J8.EQ.0)GO TO 1
22200 JUMPG 14,BS92 ; IF(J8.GT.0)GO TO 92
22400 ; FOR J8=-(10+DN) OR -(20+DN) R9=R3+RX
22700 MOVE 5,.COMM.+4
22800 FADR 5,12 ; IF(J8.LE.-20)R9=R6-RX
23300 CAMLE 14,[-=20]
23400 JRST .+3
23500 MOVN 5,12
23600 FADR 5,.COMM.+7
24000 ; 07400 192 J8=-J8
24100 BS192: MOVNS 14
24300 BS92: JUMPN 10,.+3 ;92 IF(J10.EQ.0)J10=MOD(J8,10)
24600 MOVE 7,14
24700 IDIVI 7,=10 ; IF(J10.EQ.0)J10=1
25600 SKIPN 10
25700 MOVEI 10,1
26200 MOVE 2,10 ; R10=J10
26300 TLC 2,232000
26350 FADR 2,2
26400 MOVEM 2,.COMM.+=11 ;IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
26800 ; 08000 1 IF(IABS(J4).LT.100)GO TO 97
26900 BS1: MOVM .COMM.+=25
27100 CAIGE 00,144
27500 JRST BS97
27700 ; 08100 RMINI=.6*RSTJ2
27800 MOVE 02,[0.6]
27900 FMPR 02,STF+=8
28000 MOVEM 02,MIN+1
28200 ; 08200 R5=AMOD(R5,100.0)
28300 JSA 16,AMOD
28400 JUMP .COMM.+6
28500 JUMP [100.0]
28600 MOVEM 00,.COMM.+6 ; SPACE BETWEEN BEAMS
29000 ; 08400 97 RJ=RMINI*11.
29100 BS97: MOVSI 2,204540
29200 FMPR 2,MIN+1
29300 MOVEM 2,ALF+=11
29400 MOVSI 206600 ;MOVE [48.0] ;RW=RMINI*RHGT
29500 FMPR MIN+1
29600 MOVEM ALF+=9 ; DIST. UP OR DOWN FROM NOTE HEAD.
29700 FMPR 2,.COMM.+=11 ;RJA=R10*RJ
29750 MOVEM 2,ALF+=14 ; DISPLACEMENT
29800 MOVEM 5,.COMM.+=10 ; RD=R9
29900 MOVEM 5,ALF+7 ; POSITION 3
31600 FSBR 2,ALF+=9
31800 FADR 02,.COMM.+2 ; RJX=CENTR-RW+RJA
31900 MOVEM 02,ALF+=10 ; FINAL HEIGHT OF LEFT SIDE
32300 ; 09300 C NEG R7=TREMOLO
32800 ; 09400 RX=MOD(J7,10)
32900 MOVE 11,6
33000 IDIVI 11,=10
33100 TLC 12,232000
33200 FADR 12,12
33300 MOVEI 1,(6) ; PUT J7 IN 1 FOR NOW
33700 SUBI 6,=20 ;9500 JJ2=J7-20
34200 ; 09600 RA=R6
34300 MOVE 02,.COMM.+7
34400 MOVEM 02,BM ; HORIZANTAL DIST.
34800 ; RJY=R5*RST7+POS-RST18-RW+RJA
34900 MOVSI 3,203700 ; 7.0
35000 FMPR 03,.COMM.+6
35050 FSBR 3,[18.0]
35060 FMPR 3,STF+=8
35100 FADR 3,ALF+=14
35200 FADR 3,POSI+=9
35250 FSBR 3,ALF+=9
35600 MOVEM 3,BM+2 ; VERTICAL POS OF RIGHT SIDE.
36300 ; 10000 RW=R14*RMINI
36400 MOVE 4,[14.54]
36500 FMPR 4,MIN+1
36600 MOVEM 4,ALF+=9
36800 ; 10100 RY=1.
36900 MOVSI 02,201400
37000 MOVEM 02,RY#
37200 CAIL 1,24 ;200 IF(J7.GE.20)GO TO 98
37500 JRST BS98 ; JUMP IF STEMS ARE DOWN
37900 ; 10400 RY=-RY
38000 MOVNS 00,RY
38500 ; 10500 C FOR THICKENING INCR.
38700 ADDI 6,=10 ;0600 JJ2=J7-10
39200 ; 10700 RJ=-RJ
39300 MOVNS 00,ALF+=11
39500 ; 10800 RJA=RMINI*R2HGT-2.*RJA
39600 MOVE 02,[96.0]
39700 FMPR 02,MIN+1
39800 MOVE 03,ALF+=14
39900 FSC 03,1
40000 FSBR 02,3
40100 MOVEM 02,ALF+=14
40300 ; 10900 RJX=RJX+RJA
40500 FADRM 02,ALF+=10
40700 ; 11000 RJY=RJY+RJA
40900 FADRM 02,BM+2
41100 ; 11100 R3Q=R3Q+RW
41300 FADRM 4,13 ; POSITION 1
41700 ; 11300 RA=RA+RW
41900 FADRM 4,BM ; POSITION 2
42300 ; 11500 RD=RD+RW
42500 FADRM 4,ALF+7
42900 ; 11700 RH=RH+RW
43100 FADRM 4,RH
43300 ; 11800 98 RSTJ2=RSTJ2*RBM
43700 BS98: MOVE 02,[0.83]
43800 FMPRM 02,STF+=8
44000 ; RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
44200 MOVEM 6,POSI+=8 ; JJ2 12000 93 IF(JJ2.GT.RX)GO TO 94
44400 TLC 6,232000
44500 FADR 6,6
44550 CAMLE 6,12
44600 JRST BS94
44800 CAIL 10,=10 ;2100 IF(J10.GE.10)GO TO 7
45100 JRST BS7
45200
45300 ; 12200 C**********************
45600 JUMPE 14,BS94 ; IF(J8.EQ.0)GO TO 94
45900 ; 12400 R3=RW
46300 ; 12500 IF(J9.EQ.0)GO TO 292
46400 MOVE 02,.COMM.+=30
46500 JUMPE 02,BS292
46900 CAIL 14,24 ; IF(J8.GE.20)GO TO 193
47000 JRST BS193
47200 ; 12700 293 RX=R3Q-RD
47300 BS293: MOVE 12,13
47400 FSBR 12,ALF+7
47700 ; 12800 GO TO 194
47800 JRST BS194
48000 ; 12900 7 RHX=RH-R3Q
48500 ; 13000 R3=RD-R3Q
48600 BS7: MOVN 4,13
49000 FADR 4,ALF+7
49300 ; 13100 GO TO 292
49400 JRST BS292
49600 ; 13200 193 RX=RD-RA
49700 BS193: MOVE 12,ALF+7
49800 FSBR 12,BM
50100 ; 13300 194 R3=ABS(RX)
50200 BS194: MOVM 4,12
50600 ; 13400 292 DISX=ABS(R3Q-RA)
50700 BS292: MOVE 02,13
50800 FSBR 02,BM
50900 MOVMM 02,ALF+=16
51400 ; 13500 HGT=RJX-RJY
51500 MOVE 3,ALF+=10
51600 FSBR 3,BM+2
51700 MOVEM 3,HGT#
51900 CAIGE 10,=10 ;3600 IF(J10.GE.10)HGT1=HGT*RHX/DISX
52000 JRST BS10
52010 MOVN 1,13
52020 FADR 1,RH
52030 FMPR 1,3
52040 FDVR 1,2 ; 1 HAS -HGT1
53100 ; 13800 R3=R3/DISX
53300 BS10: FDVR 4,ALF+=16
53400 MOVEM 4,.COMM.+4
53600 ; 13900 195 HGT=HGT*R3
53800 FMPRB 4,HGT
54300 ; 14000 196 L=J8/10
54800 ; 14100 J8=0
54900 SETZM .COMM.+=29
55100 CAIL 10,=10 ;14200 IF(J10.GE.10)GO TO 8
55400 JRST BS8
55410 IDIVI 14,=10 ;( L=J8/10)
55800 CAIN 14,1 ; IF(L.EQ.1)GO TO 95
56100 JRST BS95
56300 ; C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
56500 ; 14600 R3Q=RD
56600 MOVE 13,ALF+7
56900 ; 14700 RJX=RJY+HGT
57100 FADR 04,BM+2 ; 4 WAS HGT
57200 MOVEM 04,ALF+=10
57400 ; 14800 GO TO 94
57500 JRST BS94
57900 ; 15000 8 R3Q=RH
58000 BS8: MOVE 13,RH
58700 ; 15200 RJY=RJX-HGT
58800 MOVE 02,ALF+=10
58900 FSBR 02,HGT
59000 MOVEM 02,BM+2
59700 FADRM 1,ALF+=10 ;15300 RJX=RJX-HGT1
59900 ; 15400 GO TO 94
60000 JRST BS94-2
60200 ; 15500 95 RA=RD
60600 ; 15600 RJY=RJX-HGT
60700 BS95: MOVE 02,ALF+=10
60800 FSBR 02,HGT
60900 MOVEM 02,BM+2
60920 MOVE 02,ALF+7
61010 MOVEM 02,BM
61100 BS94: MOVEM 13,ALF+5 ;(R3Q)15700 94 L=7.*RMINI
61200 MOVSI 02,203700
61300 FMPR 02,MIN+1
61400 JSA 16,IFIX
61500 JUMP 2
61600 MOVEM 00,ALF+=12
61800 ; 15800 930 RC=0
61900 BS930: SETZM BM+1
62100 ; C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
62300 ; 16000 CALL LINES(R3Q,RJX,3)
62400 JSA 16,LINES
62500 JUMP ALF+5
62600 JUMP ALF+=10
62700 JUMP [3]
62900 ; 16100 DO 941 K=1,L
63000 MOVEI 15,1
63400 ; 16200 CALL BMS
63500 BS12: JSA 16,BMS
63700 ; 16300 IF(PLT.GE.0)GO TO 940
63800 MOVE 02,PLTR
63900 JUMPGE 02,BS940
64100 ; 16400 RC=RC+RY
64200 MOVE 02,RY
64300 FADRM 02,BM+1 ; FOR THICKENING.
65000 ; 16600 CALL BMS
65100 JSA 16,BMS
65300 MOVE 1,ALF+5 ; CALL EXCH(RA,ALF+5)
65500 EXCH 1,BM
65600 MOVEM 1,ALF+5
65700 MOVE 1,ALF+=10
65800 EXCH 1,BM+2 ; 941 CALL EXCH(RJY,RJX)
65900 MOVEM 1,ALF+=10
66200 CAMGE 15,ALF+=12
66300 AOJA 15,BS12
66500 ; 16900 CALL BMS
66600 JSA 16,BMS ; DRAWS 5 LINES FOR BEAMS.
67000 ; 17100 940 JJ2=JJ2-1
67100 BS940: SOSG POSI+=8
67300 ; 17200 IF(JJ2.LE.0)GO TO 942
67500 JRST BS942 ; IF P7=10 OR 20 ONE BEAM WILL APPEAR.
67900 ; 17400 RJY=RJY+RJ
68000 MOVE 02,ALF+=11
68100 FADRM 02,BM+2
68300 ; 17500 RJX=RJX+RJ
68500 FADRM 02,ALF+=10
68700 ; 17600 GO TO 930
68800 JRST BS930
69200 ; 17800 942 IF(R8.NE.0)RETURN
69300 BS942: SKIPN .COMM.+=9
69400 SKIPN .COMM.+=10
69500 JRA 16,(16)
69800 ; 17900 IF(R9.EQ.0)RETURN
70700 ; 18000 IF(R10.GE.30)RETURN
70800 MOVSI 02,205740
70900 CAMG 02,.COMM.+=11
71000 JRA 16,(16) ; C FOR NUMBERS OUTSIDE BEAMS
71600 ; 18200 RSTJ2=RMINI
71700 MOVE 02,MIN+1
71800 MOVEM 02,STF+=8
72000 ; 18300 RD=-10.
72100 MOVN 3,[10.0]
72400 ; 18400 IF(R7.LT.20)RD=8.3
72500 MOVSI 02,205500
72600 CAMLE 02,.COMM.+=8
72800 MOVE 3,[8.3]
73200 ; 18500 943 J3=R3Q+(RA-R3Q)/2.
73300 BS943: MOVN 02,ALF+5
73400 FADR 02,BM
73500 FSC 02,777777
73600 FADR 02,ALF+5
73700 JSA 16,IFIX
73800 JUMP 2
73900 MOVEM 00,.COMM.+=24
74100 ; 18600 R6=1.
74200 MOVSI 02,201400
74300 MOVEM 02,.COMM.+7
74320 ; 18900 R7=1
74420 MOVEM 02,.COMM.+=8 ; C ITALICS
74700 ; 18800 R4=R4+(R5-R4)/2.+RD
74800 MOVE 02,.COMM.+6
74900 FSBR 02,.COMM.+5
74910 FSC 02,777777
75000 FADR 2,3
75100 FADRM 02,.COMM.+5 ↔ SETZM .COMM.+=12 ; R11=0
76500 ; 19100 CALL MAKNUM(R9)
76600 JSA 16,MAKNUM
76700 JUMP .COMM.+=10
76900 JRA 16,(16) ; 19300 END
77000 END